home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / OpenLinux 2.3 CD.iso / live / usr / lib / rpm-2.5.5 / fixup.pl < prev    next >
Encoding:
Perl Script  |  1998-11-26  |  3.3 KB  |  135 lines
  1. #!/usr/bin/perl -w
  2. # $Id: fixup.pl,v 1.6 1997/11/24 05:35:36 ray Exp ray $
  3. #use strict;
  4.  
  5. ($C = $0) =~ s%.*/%%;
  6.  
  7. my $Target = "";
  8. my $Rght = "";
  9. my $Wrng = "";
  10. my $RE = "";
  11.  
  12. my $Help = 0;
  13. my $OptErr = "";
  14. my $Global = 0;
  15. my $First = 1;
  16. my $Orig = 0;
  17. my $verbose = 0;
  18. my $debug = 0;
  19.  
  20. sub Usage ($$) {
  21.   my( $rv, $msg) = @_;
  22.   print( STDERR $msg . "\n") if ( $msg );
  23.   printf( STDERR "Usage: $C [options] target wrong right\n");
  24.   $rv = 0 if ( $Opt{'help'} );
  25.   exit( $rv);
  26. }
  27.  
  28. {
  29.   use Getopt::Long;
  30.   $Getopt::Long::debug = 0;
  31.   $Getopt::Long::ignorecase = 0;
  32.   #$Getopt::Long::pass_through = 1;
  33.   $Getopt::Long::bundling = 1;
  34.   %Opt = ();
  35.  
  36.   Usage(1, "") unless ( GetOptions( \%Opt,
  37.     'help|h', 'verbose|v', 'debug|d', 'orig|b',
  38.     'global|g', 'interpreter-only|i',
  39.     'target|T=s', 'RE|e=s') && ! $Opt{'help'} );
  40.  
  41.   ( $Global ++, $First = 0 ) if ( $Opt{'global'} );
  42.   ( $RE = $Opt{'RE'}, $Global ++, $First = 0 ) if ( $Opt{'RE'} );
  43.   $First ++ if ( $Opt{'interpreter-only'} );
  44.   $Orig ++ if ( $Opt{'orig'} );
  45.   $verbose ++ if ( $Opt{'verbose'} );
  46.   ( $debug ++, $verbose ++ ) if ( $Opt{'debug'} );
  47.   $Help ++ if ( $Opt{'help'} );
  48.   $Target = $Opt{'target'} if ( $Opt{'target'} );
  49.  
  50. }
  51.  
  52.  
  53. if ( $#ARGV >= $[ ) {
  54.   Usage( 1, "") unless ( $#ARGV == $[ + 2 && ! $Target && ! $RE );
  55.   $Target = shift;
  56.   $Wrng = shift;
  57.   $Rght = shift;
  58.   printf( STDERR "Target='%s' Wrng='%s' Rght='%s'\n", $Target, $Wrng, $Rght)
  59.      if ( $debug );
  60. } elsif ( ! $Target ) {
  61.   Usage( 2, "$C: no target specified.\n");
  62. } elsif ( ! -e "$Target" ) {
  63.   Usage( 3, "$C: $Target: no such object.\n");
  64. } elsif ( ! $RE ) {
  65.   Usage( 4, "");
  66. }
  67.  
  68. if ( $First ) {
  69.   Usage( 5, "$C: '--interpreter-only' and '--re' are mutual exclusive.\n")
  70.      if ( $RE );
  71.   Usage( 6, "$C: '--global' and '--interpreter-only' are mutual exclusive.\n")
  72.      if ( $Global );
  73.   Usage( 7, "$C: '--interpreter-only' requires 'wrong' and 'right'.\n")
  74.      unless ( $Wrng && $Rght );
  75.   $RE= 's^(\#\!\s*\S*)' . $Wrng . '$1' . $Rght . 'o';
  76. } else {
  77.   $RE= 's' . $Wrng . '' . $Rght . 'ogs' unless ( $RE );
  78. }
  79. undef( $Wrng);
  80. undef( $Rght);
  81. printf( STDERR "Target='%s' RE='%s'\n", $Target, $RE) if ( $debug );
  82. #exit(42);
  83.  
  84. open( FIND, "find $Target -type f -print |") || die;
  85.  
  86. while ( defined($f = <FIND>) ) {
  87.   chop($f);
  88.   my $n = $f . ".fixed" . $$;
  89.   my $m = 0;
  90.   next unless ( -s $f );
  91.   open( IN, "< $f") || die;
  92.   open( OUT, "> $n") || die;
  93.  
  94.   $_ = <IN>;
  95.   if ( $Global ) {
  96.     do {
  97.       $m += eval "$RE";
  98.       print( OUT $_) || die;
  99.     } while ( <IN> );
  100.   } else {
  101.     $m += eval $RE;
  102.     if ( $m ) {  
  103.       do {
  104.         print( OUT $_) || die;
  105.       } while ( <IN> );
  106.     }
  107.   }
  108.   close( OUT);
  109.   if ( $m ) {
  110.     printf( "%s: %d occurance%s\n", $f, $m, ($m == 1)?"":"s") if ( $verbose );
  111.     cpmod( $f, $n);
  112.     if ( $Orig ) {
  113.       rename( $f, $f . ".orig") || die;
  114.     }
  115.     rename( $n, $f) || die;
  116.   } else {
  117.     unlink( $n) || die;
  118.     printf( "%s: OK\n", $f) if ( $verbose >= 2 );
  119.   }
  120.   close( IN);
  121. }
  122.  
  123. exit( 0);
  124.  
  125. sub cpmod($$) {
  126.   my( $Org, $Dup) = @_;
  127.   my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  128.       $atime,$mtime,$ctime,$blksize,$blocks) = stat($Org);
  129.   $mode &= 007777;
  130.   chown( $uid, $gid, $Dup) || die( "$CMD: cannot chown( $uid, $gid, $Dup).\n");
  131.   chmod( $mode, $Dup) || die( "$CMD: cannot chmod( $mode, $Dup).\n");
  132.   utime( $atime, $mtime, $Dup) || die( "$CMD: cannot utime( $Dup).\n");
  133. }
  134.  
  135.